BEGIN "FOCUS"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "REDPIC.SAI[VIS,HPM]" SOURCE_FILE;
STRING INP,S; INTEGER ARRAY T[0:10]; 
INTEGER PHIG,PWID,I,J,IX,IY,FOO,OFSET,OFSET2; REAL X,Y;

DO PRINT("Input picture:") UNTIL GETPFD(INP←INCHWL,T[0])>0;
PRINT("Feature location (Y, X):"); S←INCHWL;
Y←REALSCAN(S,FOO); X←REALSCAN(S,FOO);

PHIG←T[PCLN]; PWID←T[LNBY];
   BEGIN
   INTEGER ARRAY IP[0:REDDIM(PHIG,PWID,9)], TIP[0:PFLDIM(INP)],
                 WD[0:WNFDIM(INP,8)],
                 PS[0:REDDIM(256,256,9)];
   GETPFL(INP,TIP[0]);
   MAKRED(PHIG,PWID,9,IP[0]);
   SHRINK(TIP[0],IP[IP[1]]);
      BEGIN
      INTEGER MIP,MTIP;
      INTEGER ARRAY XFRM[0:MIP←IP[IP[1]+BMAX]];
      MTIP←TIP[BMAX] LSH (9-TIP[BYBI]);
      FOR I←0 STEP 1 UNTIL MIP DO
         BEGIN
         XFRM[I]←I*MIP/MTIP;
         END;
      PERBIT(IP[IP[1]],XFRM[0]);
      END;
   PICRED(IP[0]);
   REDWIN(IP[0],Y,X,8,WD[0]);
   MAKRED(256,256,9,PS[0]);
   SHRINK(IP[IP[1]],PS[PS[1]]);
   PICRED(PS[0]);
   OFSET←0;

   PRSFIL("");
   FOR I←5 STEP -1 UNTIL 1 DO
      BEGIN
      SHRINK(PS[PS[I+1]],PS[PS[I]]);
      LOWPAS(PS[PS[I]]);
      OFSET←2*OFSET+1;
      END;

   IY←Y*(256-OFSET); IX←X*(256-OFSET);

      BEGIN
      INTEGER ARRAY TR[0:PIXDIM(256-OFSET,256-OFSET,9)];
      MAKPIX(256-OFSET,256-OFSET,9,TR[0]);
      TILE(PS[PS[1]],0,0,256-OFSET,256-OFSET,TR[0],0,0);
      FOR I←5 STEP -1 UNTIL 1 DO
	 BEGIN
	 INTEGER ARRAY RP[0:REDDIM(8*2↑(I-1),8*2↑(I-1),9)];
	 INTEGER SW;
        
	 SW←8*2↑(I-1);
	 MAKRED(SW,SW,9,RP[0]);
	 SHRINK(WD[WD[I]],RP[RP[I]]);
	 OFSET2←0;
	 FOR J←I-1 STEP -1 UNTIL 1 DO
	    BEGIN
	    SHRINK(RP[RP[J+1]],RP[RP[J]]);
	    LOWPAS(RP[RP[J]]);
	    OFSET2←2*OFSET2+1;
	    END;
	 TILE(RP[RP[1]],0,0,
	      SW-OFSET2,SW-OFSET2,
	      TR[0],IY-(SW-OFSET2)%2,IX-(SW-OFSET2)%2);
         
	 END;
      PUTPFL(TR[0],"REDEX.PIC[DIA,HPM]",2)
      END;
   IX←X*IP[IP[1]+LNBY]; IY←Y*IP[IP[1]+PCLN];
   FOR I←1 STEP 1 UNTIL 6 DO
      BEGIN
      INTEGER IW,LX,LY,K;
      PROCEDURE AL(INTEGER I,J);
        PUTEL(IP[IP[1]],I,J,
        IF PIXEL(IP[IP[1]],I,J)>IP[IP[1]+BMAX]%2 THEN 0 ELSE IP[IP[1]+BMAX]);
      IW←2↑(I+2);
      LX←IX-IW%2; LY←IY-IW%2;
      FOR K←LX STEP 1 UNTIL LX+IW DO BEGIN AL(LY,K); AL(LY+IW,K); END;
      FOR K←LY STEP 1 UNTIL LY+IW DO BEGIN AL(K,LX); AL(K,LX+IW); END;
      END;
   PUTPFL(IP[IP[1]],"LINEX.PIC[DIA,HPM]");
   END;

END "FOCUS";